unit deconstruction;

interface

  function  HexStr(x : integer) : String;
  function  DeComp(x : integer) : String;
  function  Decompose(x : integer) : String;

implementation

  function  HexStr(x : integer) : String;
    // calculates the hexadecimal equivalent string for the cell's program
  const
    hexchar : array[0..15] of char = ('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
  var
    i   : integer;
    hex : string;
  begin
    hex := '';
    if x = 0 then
      hex := '0'
    else
      while x <> 0 do
      begin
        i := x AND $000f;
        x := x shr 4;
        hex := hexchar[i] + hex;
      end;
    result := hex;
  end;

function decomp(x : integer): string;
const
  A1 : integer = $ff00;  A0 : integer = $00ff;
  B1 : integer = $f0f0;  B0 : integer = $0f0f;
  C1 : integer = $cccc;  C0 : integer = $3333;
  D1 : integer = $aaaa;  D0 : integer = $5555;

begin
  if x = 0       then begin result := 'FALSE';   exit; end;
  if x = $ffff   then begin result := 'TRUE';    exit; end;
  if x = A1      then begin result := 'A';       exit; end;
  if x = A0      then begin result := '~A';      exit; end;
  if x = B1      then begin result := 'B';       exit; end;
  if x = B0      then begin result := '~B';      exit; end;
  if x = C1      then begin result := 'C';       exit; end;
  if x = C0      then begin result := '~C';      exit; end;
  if x = D1      then begin result := 'D';       exit; end;
  if x = D0      then begin result := '~D';      exit; end;

// handle cases which don't bifurcate things first

  if (x AND A1) = A1 then
  begin
    x := x AND A0;
    x := x OR (x shl 8);
    result := 'A OR '+ decompose(x);
    exit;
  end;

  if (x AND A0) = A0 then
  begin
    x := x AND A1;
    x := x OR (x shr 8);
    result := '~A OR '+decompose(x);
    exit;
  end;

  if (x AND A1) = 0 then
  begin
    x := x AND A0;
    x := x OR (x shl 8);
    result := '~A AND '+decompose(x);
    exit;
  end;

  if (x AND A0) = 0 then
  begin
    x := x AND A1;
    x := x OR (x shr 8);
    result := 'A AND '+decompose(x);
    exit;
  end;

  if ((x AND A1) SHR 8) = ((NOT x) AND A0) then
  begin
    x := x AND A0;
    x := x OR (x shl 8);
    result := 'A XOR '+decompose(x);
    exit;
  end;

// anything involving A doesn't make it here...


  if (x AND B1) = B1 then
  begin
    x := x AND B0;
    x := x OR (x shl 4);
    result := 'B OR '+ decompose(x);
    exit;
  end;

  if (x AND B0) = B0 then
  begin
    x := x AND B1;
    x := x OR (x shr 4);
    result := '~B OR '+decompose(x);
    exit;
  end;

  if (x AND B1) = 0 then
  begin
    x := x AND B0;
    x := x OR (x shl 4);
    result := '~B AND '+decompose(x);
    exit;
  end;

  if (x AND B0) = 0 then
  begin
    x := x AND B1;
    x := x OR (x shr 4);
    result := 'B AND '+decompose(x);
    exit;
  end;

  if ((x AND B1) SHR 4) = ((NOT x) AND B0) then
  begin
    x := x AND B0;
    x := x OR (x shl 4);
    result := 'B XOR '+decompose(x);
    exit;
  end;

// nothing with A or B gets here

  if (x AND C1) = C1 then
  begin
    x := x AND C0;
    x := x OR (x shl 2);
    result := 'C OR '+ decompose(x);
    exit;
  end;

  if (x AND C0) = C0 then
  begin
    x := x AND C1;
    x := x OR (x shr 2);
    result := '~C OR '+decompose(x);
    exit;
  end;

  if (x AND C1) = 0 then
  begin
    x := x AND C0;
    x := x OR (x shl 2);
    result := '~C AND '+decompose(x);
    exit;
  end;

  if (x AND C0) = 0 then
  begin
    x := x AND C1;
    x := x OR (x shr 2);
    result := 'C AND '+decompose(x);
    exit;
  end;

  if ((x AND C1) SHR 2) = ((NOT x) AND C0) then
  begin
    x := x AND C0;
    x := x OR (x shl 2);
    result := 'C XOR '+decompose(x);
    exit;
  end;

// handle D cases here

  if (x AND D1) = D1 then
  begin
    x := x AND D0;
    x := x OR (x shl 1);
    result := 'D OR '+ decompose(x);
    exit;
  end;

  if (x AND D0) = D0 then
  begin
    x := x AND D1;
    x := x OR (x shr 1);
    result := '~D OR '+decompose(x);
    exit;
  end;

  if (x AND D1) = 0 then
  begin
    x := x AND D0;
    x := x OR (x shl 1);
    result := '~D AND '+decompose(x);
    exit;
  end;

  if (x AND D0) = 0 then
  begin
    x := x AND D1;
    x := x OR (x shr 1);
    result := 'D AND '+decompose(x);
    exit;
  end;

  if ((x AND D1) SHR 1) = ((NOT x) AND D0) then
  begin
    x := x AND D0;
    x := x OR (x shl 1);
    result := 'D XOR '+decompose(x);
    exit;
  end;



// last resort - handle bifurcating cases here

  if ((x AND A1) SHR 8) <> (X AND A0) then
  begin
    result := '(A AND ('
              + decompose(  (x AND A1) OR ((x AND A1) SHR 8) )
              +'))  OR  (~A AND ('
              + decompose(  (x AND A0) OR ((x AND A0) SHL 8) )
              +'))';
    exit;

  end;

  if ((x AND B1) SHR 4) <> (X AND B0) then
  begin
    result := '(B AND ('
              + decompose(  (x AND B1) OR ((x AND B1) SHR 4) )
              +'))  OR  (~B AND ('
              + decompose(  (x AND B0) OR ((x AND B0) SHL 4) )
              +'))';
    exit;

  end;

  if ((x AND C1) SHR 2) <> (X AND C0) then
  begin
    result := '(C AND ('
              + decompose(  (x AND C1) OR ((x AND C1) SHR 2) )
              +'))  OR  (~C AND ('
              + decompose(  (x AND C0) OR ((x AND C0) SHL 2) )
              +'))';
    exit;

  end;


// due to complete code path coverage...we never get here... whew!

  result := 'unknown($'+hexstr(x)+')';
end;


function  Decompose(x : integer) : String;
var
  s, t : string;
begin
  s := decomp(x);
  t := '~(' + decomp(x XOR $ffff)+')';
  if length(t) <= length(s) then
    result := t
  else
    result := s;
end;


end.
